home *** CD-ROM | disk | FTP | other *** search
/ PC User 2002 July / Disc 1 / PCU0702CD1.iso / software / sfeflash / flies / en-us / ps_0 / regdb_order.cgi < prev    next >
Encoding:
Text File  |  2002-05-17  |  14.9 KB  |  615 lines
  1. #!/usr/local/bin/perl
  2.  
  3. # $external_prefix is the prefix to append to lockssl-on.gif and thankyou_url if necessary.
  4. # If you want to use "/files/lockssl-on.gif" and "/files/thankyou.html" then $external_prefix
  5. # must be set to '/files/'
  6. $external_prefix = '';
  7.  
  8. # valid referers
  9. @referers = (
  10.     '.*ordernav\.html',                # standard
  11.     '.*regdb_order\.cgi',        # standard with custom payment fields
  12.     '.*enter\.html',                # these four are for IE 5.5 beta
  13.     '.*index\.html',                #  which sends an incorrect HTTP_REFERER
  14.     '.*default\.html',                #  header
  15.     '.*home\.html',
  16.     '.*customerdtl\.html',            # should be unnecessary
  17.     '.*deliverydtl\.html',            # should be unnecessary
  18. );
  19.  
  20. @ERROR  = ();
  21. @FC        = ();
  22. %FORM   = {};
  23. %CONFIG = {};
  24. $PARAM  = "";
  25.  
  26. $HEADER_PRINTED = 0;
  27.  
  28. &parse_form();
  29. &check_referer()     or  &show_errors('bad_referer');
  30. (&check_required()   or  &show_errors('missing_fields', @ERROR)) if not @ERROR;
  31. (&check_valid_cc()   or  &show_errors('invalid_cc', @ERROR))     if not @ERROR;
  32. (&check_valid()      or  &show_errors('Invalid data', @ERROR))   if not @ERROR;
  33. if ($FORM{'submit'} and not @ERROR)
  34. {
  35.     &redirect_to_email();
  36.     exit;
  37. }
  38. else
  39. {
  40.     &print_header()      if  (not $HEADER_PRINTED);
  41.     &print_html()        and ($HEADER_PRINTED);
  42.     &print_footer()      and ($HEADER_PRINTED);
  43. }
  44.  
  45. sub URLencode
  46. {
  47.     my ($str) = (@_);
  48.     $str =~ s/([^a-zA-Z0-9_.-])/uc(sprintf("%%%02x",ord($1)))/eg;
  49.     return $str;
  50. }
  51.  
  52. sub redirect_to_email
  53. {
  54.     print qq[Content-type: text/html\n\n<html];
  55.     ($CONFIG{'html_lang'})     and print qq[ lang="$CONFIG{'html_lang'}"];
  56.     ($CONFIG{'html_dir'})     and print qq[ dir="$CONFIG{'html_dir'}"];
  57.     print qq[>
  58.         <head>
  59.     ];
  60.     ($CONFIG{'http_charset'}) and print qq[<meta http-equiv="Content-Type" content="text/html" charset="$CONFIG{'http_charset'}">];
  61.  
  62.     #xxx
  63.     print qq[
  64.         <script language="javascript">
  65.         function document_onLoad()
  66.         {
  67.             document.orderForm.submit();
  68.         }
  69.         </script>
  70.         </head>
  71.         <body onload="javascript:document_onLoad();" ].&body_attributes().qq[>
  72.         <form name="orderForm" action="regdb_email.cgi" method="post">
  73.     ];
  74.     while (($key,$value) = each %CONFIG)
  75.     {
  76.         print qq[<input type="hidden" name="$key" value="$value">\n];
  77.     }
  78.     while (($key,$value) = each %FORM)
  79.     {
  80.         next if ($key =~ /^fc\d|submit|HASH/);
  81.         print qq[<input type="hidden" name="$key" value="$value">\n];
  82.     }
  83.     print qq[
  84.         </form>
  85.         </body>
  86.         </html>
  87.     ];
  88. }
  89.  
  90. sub print_header
  91. {
  92.     print qq[Content-type: text/html\n\n<html];
  93.     ($CONFIG{'html_lang'})     and print qq[ lang="$CONFIG{'html_lang'}"];
  94.     ($CONFIG{'html_dir'})     and print qq[ dir="$CONFIG{'html_dir'}"];
  95.     print qq[>
  96.         <head>
  97.     ];
  98.     ($CONFIG{'http_charset'}) and print qq[<meta http-equiv="Content-Type" content="text/html" charset="$CONFIG{'http_charset'}">];
  99.  
  100.     print qq[
  101.         </head>
  102.         <body ].&body_attributes().qq[>
  103.     ];
  104.     $HEADER_PRINTED = 1;
  105. }
  106.  
  107. sub print_footer
  108. {
  109.     print qq[</body></html>];
  110. }
  111.  
  112. sub print_html {
  113.  
  114.     print qq[
  115.         <center><img src="${external_prefix}lockssl-on.gif"></center><br>
  116.         <center><p><b>$FORM{'ln_fill_in_order'}</b></p></center>
  117.         <center>
  118.         <form name="orderForm" method="post">
  119.         <table border="3" cellpadding="2" width="90%" bgcolor="$FORM{'doc_table_bgcolor'}">
  120.             ].&print_form_controls().qq[
  121.         </table>
  122.         </center>
  123.     ];
  124.     while (($key,$value) = each %CONFIG)
  125.     {
  126.         print qq[<input type="hidden" name="$key" value="$value">\n];
  127.     }
  128.     while (($key,$value) = each %FORM)
  129.     {
  130.         next if ($key =~ /^field_|submit/);
  131.         print qq[<input type="hidden" name="$key" value="$value">\n];
  132.     }
  133.     print qq[
  134.         <p align="center"><input type="reset" value="$FORM{'ln_clear'}">
  135.         <input type="submit" name="submit" value="$FORM{'ln_next'}"></p>
  136.         </form>
  137.     ];
  138. }
  139.  
  140. sub check_referer
  141. {
  142.     my $referer_ok = 0;
  143.     if ($ENV{'HTTP_REFERER'})
  144.     {
  145.         foreach my $referer (@referers)
  146.         {
  147.             if ($ENV{'HTTP_REFERER'} =~ /$referer/i)
  148.             {
  149.                 $referer_ok = 1;
  150.                 last;
  151.             }
  152.         }
  153.     }
  154.     else
  155.     {
  156.         $referer_ok = 1;
  157.     }
  158.     return $referer_ok;
  159. }
  160.  
  161. sub check_required {
  162.     while (@ERROR) { pop(@ERROR); }
  163.     foreach my $require (@REQUIRED) {
  164.         if ($require eq 'bgcolor' ||
  165.             $require eq 'background' ||
  166.             $require eq 'text_color' ||
  167.             $require eq 'link_color' ||
  168.             $require eq 'alink_color' ||
  169.             $require eq 'vlink_color') {
  170.             if (!($CONFIG{$require}) || $CONFIG{$require} eq ' ') {
  171.                 push(@ERROR, $require);
  172.             }
  173.         } elsif (!($FORM{$require}) || $FORM{$require} eq ' ') {
  174.             push(@ERROR, $require);
  175.         }
  176.     }
  177.     if ($FORM{'submit'})
  178.     {
  179.         my $display_name;
  180.         foreach my $fc (@FC)
  181.         {
  182.             if ($fc->{'isRequired'} && !$FORM{$fc->{'name'}})
  183.             {
  184.                 ($display_name = $fc->{'name'}) =~ s/^field_//;
  185.                 push(@ERROR, $display_name);
  186.             }
  187.         }
  188.     }
  189.     return ($#ERROR+1 ? 0 : 1);
  190. }
  191.  
  192. sub odd
  193. {
  194.     my ($n) = (@_);
  195.     return ($n & 0x0001 ? 1 : 0);
  196. }
  197.  
  198. sub validate_credit_card
  199. {
  200.     my ($num) = (@_);
  201.     $num =~ s/\D//g;
  202.     my $valid = 0;
  203.     my $len = length($num);
  204.     if ($len < 12)
  205.     {
  206.         $valid = 0;
  207.     }
  208.     else
  209.     {
  210.         my $i, $x = 0, $y = 0;
  211.         if (odd($len))
  212.         {
  213.             for ($i = ($len-2); $i >= 0; --$i)
  214.             {
  215.                 $y = (ord(substr($num, $i, 1)) - ord('0'));
  216.                 $y *= 2 if (odd($i));
  217.                 $y = (($y - 10) + 1) if ($y >= 10);
  218.                 $x += $y;
  219.             }
  220.         }
  221.         else
  222.         {
  223.             for ($i = ($len-2); $i >= 0; --$i)
  224.             {
  225.                 $y = (ord(substr($num, $i, 1)) - ord('0'));
  226.                 $y *= 2 if (not odd($i));
  227.                 $y = (($y - 10) + 1) if ($y >= 10);
  228.                 $x += $y;
  229.             }
  230.         }
  231.         $x = (10 - ($x % 10));
  232.         $x = 0 if ($x == 10);
  233.         if ($x == (ord(substr($num, $len-1, 1)) - ord('0')))
  234.         {
  235.             $valid = substr($num, 0, 1);
  236.         }
  237.         else
  238.         {
  239.             $valid = 0;
  240.         }
  241.     }
  242.     return $valid;
  243. }
  244.  
  245. sub check_valid_cc
  246. {
  247.     while (@ERROR) { pop(@ERROR); }
  248.     if ($FORM{'submit'})
  249.     {
  250.         foreach my $fc (@FC)
  251.         {
  252.             my @value = split(/, /, $FORM{$fc->{'name'}});
  253.             my $valid;
  254.             foreach my $value (@value)
  255.             {
  256.                 if (uc($fc->{'typeData'}) eq 'CREDITCARD')
  257.                 {
  258.                     $valid = &validate_credit_card($value);
  259.                     push(@ERROR, $fc->{'label'}) if (not $valid);
  260.                 }
  261.             }
  262.         }
  263.     }
  264.     return ($#ERROR+1 ? 0 : 1);
  265. }
  266. sub check_valid
  267. {
  268.     while (@ERROR) { pop(@ERROR); }
  269.     if ($FORM{'submit'})
  270.     {
  271.         foreach my $fc (@FC)
  272.         {
  273.             my @value = split(/, /, $FORM{$fc->{'name'}});
  274.             my $valid;
  275.             foreach my $value (@value)
  276.             {
  277.                 SWITCH: for (uc($fc->{'typeData'}))
  278.                 {
  279.                     /TEXT/ && do
  280.                     {
  281.                         $valid = 1;
  282.                         last;
  283.                     };
  284.                     /CREDITCARD/ && do
  285.                     {
  286.                         $valid = &validate_credit_card($value);
  287.                         last;
  288.                     };
  289.                     /EMAIL/ && do
  290.                     {
  291.                         $valid = ($value =~ /^\w[\w._]+@\w+(\.\w+)+$/);
  292.                         last;
  293.                     };
  294.                     /NUMBER/ && do
  295.                     {
  296.                         $valid = ($value =~ /^\d+$/);
  297.                         last;
  298.                     };
  299.                     /PHONE/ && do
  300.                     {
  301.                         $valid = ($value =~ /^\+?\s*((\(\d+(\s*-?\s*\d+)*\)\s*-?\s*)|(\d+(\s*-?\s*\d+)*\s*-?\s*))+\s*$/);
  302.                         last;
  303.                     };
  304.                 }
  305.                 push(@ERROR, $fc->{'label'}) if (not $valid);
  306.             }
  307.         }
  308.     }
  309.     return ($#ERROR+1 ? 0 : 1);
  310. }
  311.  
  312. sub show_errors
  313. {
  314.     my ($error, @error_fields) = @_;
  315.     my (@fatal_error) = ('bad_referer', 'request_method');
  316.  
  317.     &print_header() if (not $HEADER_PRINTED);
  318.  
  319.     SWITCH: for ($error)
  320.     {
  321.         /bad_referer/ && do
  322.         {
  323.             print qq[
  324.                 <center><h1>$FORM{'ln_badreferer'}</h1></center>
  325.                 $FORM{'ln_badreferer_desc'}
  326.             ];
  327.             last;
  328.         };
  329.         /request_method/ && do
  330.         {
  331.             print qq[
  332.                 <center><h1>Invalid Request Method</h1></center>
  333.                 <p>The Request Method of the submitted form did not match
  334.                 either GET or POST.</p>
  335.             ];
  336.             last;
  337.         };
  338.         /missing_fields/ && do
  339.         {
  340.             print qq[
  341.                 <center><h1>$FORM{'ln_error_missing'}</h1></center>
  342.                 <p>$FORM{'ln_error_fields'}:</p>
  343.             ];
  344.             print '<ul><li>'.join('<li>', @error_fields).'</ul>';
  345.             last;
  346.         };
  347.         /invalid_cc/ && do
  348.         {
  349.             print qq[
  350.                 <center><h1>$FORM{'ln_error_cc_invalid'}</h1></center>
  351.                 <p>$FORM{'ln_error_fields'}:</p>
  352.             ];
  353.             print '<ul><li>'.join('<li>', @error_fields).'</ul>';
  354.             last;
  355.         };
  356.         print qq[<center><h1>$FORM{'ln_error'}: $error</h1></center>];
  357.         print '<ul><li>'.join('<li>', @error_fields).'</ul>';
  358.     }
  359.  
  360.     if (grep(/$error/, @fatal_error))
  361.     {
  362.         &print_footer();
  363.         exit;
  364.     }
  365. }
  366.  
  367. sub parse_form
  368. {
  369.     my @pair;
  370.     my $buffer;
  371.     if ($ENV{'REQUEST_METHOD'} =~ 'GET')
  372.     {
  373.         $PARAM = $ENV{'QUERY_STRING'};
  374.         @pairs = split(/&/, $ENV{'QUERY_STRING'});        # Split the name-value pairs
  375.     }
  376.     elsif ($ENV{'REQUEST_METHOD'} =~ 'POST')
  377.     {
  378.         read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});    # Get the input
  379.         $PARAM = $buffer;
  380.         @pairs = split(/&/, $buffer);                    # Split the name-value pairs
  381.     }
  382.     else
  383.     {
  384.         &show_errors('request_method');
  385.     }
  386.  
  387.     my $key, $value, $index, $fcName;
  388.     my $choiceIndex, $choiceName;
  389.     my @choice;
  390.     foreach my $pair (@pairs)
  391.     {
  392.         ($name, $value) = split(/=/, $pair);            # Split pair into name and value
  393.  
  394.         $name  =~ tr/+/ /;                                # un-URL-encode the name
  395.         $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  396.         $value =~ tr/+/ /;                                # un-URL-encode the value
  397.         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  398.         $value =~ s/<!--(.|\n)*-->//g;                    # remove possible SSI directives from value
  399.  
  400.         if ($name =~ /^fc\d+.*/)
  401.         {
  402.             ($index)  = ($name =~ /^fc(\d+).*/);
  403.             ($fcName) = ($name =~ /^fc\d+(.*)/);
  404.             ($value  =~ /false/i) and $value = 0;
  405.             ($value  =~ /true/i)  and $value = 1;
  406.             if ( ($choiceIndex, $choiceName) = ($fcName =~ /^choices(\d+)(.*)/) )
  407.             {
  408.                 $choice[$index][$choiceIndex]{$choiceName} = $value;
  409.                 $FC[$index]{'choice'} = $choice[$index];
  410.             }
  411.             else
  412.             {
  413.                 if ($fcName eq 'name' and $value eq '')
  414.                 {
  415.                     $FORM{'submit'} = 'submit';
  416.                 }
  417.                 else
  418.                 {
  419.                     $FC[$index]{$fcName} = ($fcName eq 'name' ? 'field_' : '').$value;
  420.                 }
  421.             }
  422.         }
  423.         if ($name eq 'mail_encoding' ||
  424.             $name eq 'http_charset' ||
  425.             $name eq 'mail_charset' ||
  426.             $name eq 'html_lang' ||
  427.             $name eq 'html_dir' ||
  428.             $name eq 'bgcolor' ||
  429.             $name eq 'background' ||
  430.             $name eq 'text_color' ||
  431.             $name eq 'link_color' ||
  432.             $name eq 'alink_color' ||
  433.             $name eq 'vlink_color' && ($value))
  434.         {
  435.             $CONFIG{$name} = $value;
  436.         }
  437.         else
  438.         {
  439.             if ($FORM{$name} && ($value))
  440.             {
  441.                 $FORM{$name} = "$FORM{$name}, $value";
  442.             }
  443.             elsif ($value)
  444.             {
  445.                 $FORM{$name} = $value;
  446.             }
  447.         }
  448.     }
  449.  
  450.     # defaults
  451.     if (!$FORM{'doc_table_text'}) {
  452.         $FORM{'doc_table_text'} = "\#000000";
  453.     }
  454.     if(!$FORM{'cc_expiry_years'}) {
  455.         $FORM{'cc_expiry_years'} = "2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011";
  456.     }
  457.     if(!$FORM{'ln_badreferer'}) {
  458.         $FORM{'ln_badreferer'} = 'Bad Referrer - Access Denied';
  459.     }
  460.     if(!$FORM{'ln_badreferer_desc'}) {
  461.         $FORM{'ln_badreferer_desc'} =
  462.             'The URL of the form that is trying to use this CGI application is not in the list of valid referrers.';
  463.     }
  464.     if(!$FORM{'ln_error_missing'}) {
  465.         $FORM{'ln_error_missing'} = 'Missing Fields';
  466.     }
  467.     if(!$FORM{'ln_error'}) {
  468.         $FORM{'ln_error'} = 'Error';
  469.     }
  470.  
  471.     # set default mail charset
  472.     if(!$CONFIG{'mail_charset'}) { $CONFIG{'mail_charset'} = $CONFIG{'http_charset'}; }
  473. }
  474.  
  475. sub body_attributes
  476. {
  477.     my $str;
  478.     ($CONFIG{'background'}   =~ /http\:\/\/.*\..*/)
  479.                              and $str .= qq[ background="$CONFIG{'background'}"];
  480.     ($CONFIG{'bgcolor'})     and $str .= qq[ bgcolor="$CONFIG{'bgcolor'}"];
  481.     ($CONFIG{'link_color'})  and $str .= qq[ link="$CONFIG{'link_color'}"];
  482.     ($CONFIG{'vlink_color'}) and $str .= qq[ vlink="$CONFIG{'vlink_color'}"];
  483.     ($CONFIG{'alink_color'}) and $str .= qq[ alink="$CONFIG{'alink_color'}"];
  484.     ($CONFIG{'text_color'})  and $str .= qq[ text="$CONFIG{'text_color'}"];
  485.     return $str;
  486. }
  487.  
  488. sub print_form_controls
  489. {
  490.     my $str;
  491.     my $display_name;
  492.     foreach my $fc (@FC)
  493.     {
  494.         ($display_name = $fc->{'name'}) =~ s/^field_//;
  495.         if (uc($fc->{'typeForm'}) eq "HIDDEN")
  496.         {
  497.             $str .= get_form_control_HTML($fc);
  498.             next;
  499.         }
  500.         $str .= qq[
  501.             <tr bgcolor="$FORM{'doc_table_bgcolor'}" valign="top">
  502.                 <td align="right">
  503.                     <font size=+1 color="$FORM{'doc_table_text'}">
  504.         ];
  505.         $str .= ($fc->{'isRequired'} ? '*' : '');
  506.         $str .= qq[
  507.                     $display_name:
  508.                     </font>
  509.                 </td>
  510.                 <td align="left">
  511.                     <font size=+1 color="$FORM{'doc_table_text'}">
  512.                     ].&get_form_control_HTML($fc).qq[
  513.                 </font>
  514.                 </td>
  515.             </tr>
  516.         ];
  517.     }
  518.     return $str;
  519. }
  520.  
  521. sub get_form_control_HTML
  522. {
  523.     my ($fc) = (@_);
  524.  
  525.     my $str = "";
  526.     SWITCH: for (uc($fc->{'typeForm'}))
  527.     {
  528.         /^LABEL$/ && do
  529.         {
  530.             $str .= ($fc->{'name'} or $fc->{'choice'}[0]{'value'});
  531.             last;
  532.         };
  533.         /^HIDDEN$/ && do
  534.         {
  535.             $str .= qq[<INPUT TYPE="hidden" NAME="$fc->{'name'}"];
  536.             $str .= qq[ VALUE="].($fc->{'label'} or $fc->{'choice'}[0]{'value'}).qq["];
  537.             $str .= qq[>];
  538.             last;
  539.         };
  540.         /^TEXT$/ && do
  541.         {
  542.             $str .= qq[<INPUT TYPE="TEXT" NAME="$fc->{'name'}"];
  543.             ($fc->{'cols'} > 0)      and $str .= qq[ SIZE="$fc->{'cols'}"];
  544.             ($fc->{'maxLength'} > 0) and $str .= qq[ MAXLENGTH="$fc->{'maxLength'}"];
  545.             $str .= qq[ VALUE="].($fc->{'label'} or $fc->{'choice'}[0]{'value'}).qq["];
  546.             $str .= qq[>];
  547.             last;
  548.         };
  549.         /^TEXTAREA$/ && do
  550.         {
  551.             $str .= qq[<TEXTAREA WRAP="soft" NAME="$fc->{'name'}"];
  552.             ($fc->{'cols'} > 0)      and $str .= qq[ COLS="$fc->{'cols'}"];
  553.             ($fc->{'rows'} > 0)      and $str .= qq[ ROWS="$fc->{'rows'}"];
  554.             ($fc->{'maxLength'} > 0) and $str .= qq[ MAXLENGTH="$fc->{'maxLength'}" ONCHANGE="if (this.value.length > $fc->{'maxLength'}) this.value=this.value.substring(0,$fc->{'maxLength'});"];
  555.             $str .= qq[>];
  556.             $str .= ($fc->{'label'} or $fc->{'choice'}[0]{'value'});
  557.             $str .= qq[</TEXTAREA>];
  558.             last;
  559.         };
  560.         /^CHECKBOX$|_CHECKBOX$/ && do
  561.         {
  562.             my @value = split(/, /, $FORM{$fc->{'name'}});
  563.             for my $choice (@{$fc->{'choice'}})
  564.             {
  565.                 $str .= qq[<INPUT TYPE="checkbox" NAME="$fc->{'name'}" VALUE="$choice->{'value'}"];
  566.                 ($fc->{'label'} eq $choice->{'value'}) and $str .= qq[ CHECKED];
  567.                 $str .= qq[>$choice->{'name'} <BR>];
  568.             }
  569.             last;
  570.         };
  571.         /^RADIO$|_RADIO$/ && do
  572.         {
  573.             for my $choice (@{$fc->{'choice'}})
  574.             {
  575.                 $str .= qq[<INPUT TYPE="radio" NAME="$fc->{'name'}" VALUE="$choice->{'value'}"];
  576.                 ($fc->{'label'} eq $choice->{'value'}) and $str .= qq[ CHECKED];
  577.                 $str .= qq[>$choice->{'name'} <br>];
  578.             }
  579.             last;
  580.         };
  581.         /^SELECT$|_COMBO$|_LISTBOX$/ && do
  582.         {
  583.             $str .= qq[<FONT SIZE="-1"><SELECT NAME="$fc->{'name'}"];
  584.             ($fc->{'rows'} > 0) and $str .= qq[ SIZE="$fc->{'rows'}"];
  585.             $str .= ($fc->{'isMultiChoice'} ? qq[ MULTIPLE>] : qq[>]);
  586.             $str .= qq[ <OPTION VALUE=""></OPTION>];
  587.             if ($fc->{'isMultiChoice'})
  588.             {
  589.                 # deprecated.  no facility to have multiple default values
  590.                 my @value = split(/, /, $FORM{$fc->{'name'}});
  591.                 for my $choice (@{$fc->{'choice'}})
  592.                 {
  593.                     $str .= qq[  <OPTION VALUE="$choice->{'value'}"];
  594.                     ($fc->{'label'} eq $choice->{'value'}) and $str .= qq[ SELECTED];
  595.                     $str .= qq[>$choice->{'name'}</OPTION>];
  596.                 }
  597.             }
  598.             else
  599.             {
  600.                 for my $choice (@{$fc->{'choice'}})
  601.                 {
  602.                     $str .= qq[ <OPTION VALUE="$choice->{'value'}"];
  603.                     ($fc->{'label'} eq $choice->{'value'}) and $str .= qq[ SELECTED];
  604.                     $str .= qq[>$choice->{'name'} <br>];
  605.                 }
  606.             }
  607.             $str .= qq[</SELECT></FONT>];
  608.             last;
  609.         };
  610.         $str .= qq[<p>Unknown form control</p>];
  611.     }
  612.     return($str);
  613. }
  614.  
  615.